Sprite 1984 - 1993/Sprite 1984 - 1993.iso/src/lib/tclX6.4c/dist/tests/flock.test

Text File | 1992-11-07 | 5.9 KB | 230 lines

#
# filecmds.test
#
# Tests for the flock and funlock commands.
#---------------------------------------------------------------------------
# Copyright 1992 Karl Lehenbauer and Mark Diekhans.
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose and without fee is hereby granted, provided
# that the above copyright notice appear in all copies.  Karl Lehenbauer and
# Mark Diekhans make no representations about the suitability of this
# software for any purpose.  It is provided "as is" without express or
# implied warranty.
#------------------------------------------------------------------------------
# $Id: flock.test,v 2.0 1992/10/16 04:49:43 markd Rel $
#------------------------------------------------------------------------------
#

if {[info procs test] != "test"} then {source testlib.tcl}

catch {flock} msg
if {$msg == "File locking is not available on this system"} return

#
# Create and open a read file and a write file.
#
unlink -nocomplain {FLOCKR.TMP FLOCKW.TMP}

foreach X {R W RW} {
    set fh [open FLOCK${X}.TMP w]
    puts $fh [replicate X 100]
    close $fh
}

set readFH  [open FLOCKR.TMP r]
set writeFH [open FLOCKW.TMP w]
set rdwrFH  [open FLOCKRW.TMP r+]

#
# Check flock argument checking
#

set flockWrongArgs {wrong # args: flock [-read|-write] [-nowait] handle [start] [length] [origin]}

Test flock-1.1 {flock argument checking} {
    flock
} 1 $flockWrongArgs

Test flock-1.2 {flock argument checking} {
    flock $readFH 0 0 0 0
} 1 $flockWrongArgs

Test flock-1.3 {flock argument checking} {
    flock -writx $readFH
} 1 {invalid option "-writx" expected one of "-read", "-write", or "-nowait"}

Test flock-1.4 {flock argument checking} {
    flock -nowait
} 1 $flockWrongArgs

Test flock-1.5 {flock argument checking} {
    flock foofile
} 1 {bad file identifier "foofile"}

Test flock-1.6 {flock argument checking} {
    flock $readFH x
} 1 {expected integer but got "x"}

Test flock-1.7 {flock argument checking} {
    flock $readFH 1 x
} 1 {expected integer but got "x"}

Test flock-1.8 {flock argument checking} {
    flock $readFH {} x
} 1 {expected integer but got "x"}

Test flock-1.9 {flock argument checking} {
    flock $readFH {} 1 bad
} 1 {bad origin "bad": should be "start", "current", or "end"}

Test flock-1.10 {flock argument checking} {
    flock $readFH
} 1 {file not open for writing}

Test flock-1.11 {flock argument checking} {
    flock -write $readFH
} 1 {file not open for writing}

Test flock-1.12 {flock argument checking} {
    flock -read $writeFH
} 1 {file not open for reading}

Test flock-1.13 {flock argument checking} {
    flock -read -write $rdwrFH
} 1 {can not specify both "-read" and "-write"}


#
# Check funlock argument checking
#

set funlockWrongArgs {wrong # args: funlock handle [start] [length] [origin]}

Test flock-2.1 {funlock argument checking} {
    funlock
} 1 $funlockWrongArgs

Test flock-2.2 {funlock argument checking} {
    funlock $readFH 0 0 0 0
} 1 $funlockWrongArgs

Test flock-2.3 {funlock argument checking} {
    funlock -write $readFH
} 1  {bad file identifier "-write"}

Test flock-2.4 {funlock argument checking} {
    funlock foofile
} 1 {bad file identifier "foofile"}

Test flock-2.5 {funlock argument checking} {
    funlock $readFH x
} 1 {expected integer but got "x"}

Test flock-2.6 {funlock argument checking} {
    funlock $readFH 1 x
} 1 {expected integer but got "x"}

Test flock-2.7 {funlock argument checking} {
    funlock $readFH {} x
} 1 {expected integer but got "x"}

Test flock-2.8 {funlock argument checking} {
    funlock $readFH {} 1 bad
} 1 {bad origin "bad": should be "start", "current", or "end"}

#
# If problems with acquiring locks, bail out now, as some tests may hang.
#
if {[catch {flock $writeFH} msg] != 0} {
    puts stderr "*************************************************************"
    puts stderr "Error acquiring file lock, may be system configuration"
    puts stderr "rest of lock tests skipped"
    puts stderr "    $msg"
    puts stderr "*************************************************************"
    catch {close $writeFH}
    catch {close $readFH}
    catch {close $rdwrFH}
    unlink -nocomplain {FLOCKR.TMP FLOCKRW.TMP FLOCKW.TMP}
    return
}
funlock $writeFH


#
# Check locking of a file that is not locked
#

Test flock-3.1 {flock/unlock of a file that is not locked} {
   flock $writeFH
   funlock $writeFH
} 0 {}

Test flock-3.2 {flock/unlock of a file that is not locked} {
   flock -write $writeFH
   funlock $writeFH
} 0 {}

Test flock-3.3 {flock/unlock of a file that is not locked} {
   flock -write $rdwrFH
   funlock $rdwrFH
} 0 {}

Test flock-3.2 {flock/unlock of a file that is not locked} {
   flock -read $readFH
   funlock $readFH
} 0 {}

#
# Start a process to lock a file.  A pipe will be used to report when its
# locked.

pipe fromChild toParent
flush stdout
flush stderr
set lockerPid [fork]
if {$lockerPid == 0} {
   flock $writeFH
   flock $rdwrFH 0 10
   puts $toParent "*I am ready*"
   flush $toParent
   while 1 {sleep 20}
   exit 0
}
if {([gets $fromChild line] < 0) || ([set line] != "*I am ready*")} {
   error "Unexpected response from flock test child: $line"}

Test flock-4.1 {flock of file locked by child process} {
   flock -nowait $writeFH
} 0 0

Test flock-4.2 {flock of file locked by child process} {
   flock -nowait $rdwrFH 0 5
} 0 0

Test flock-4.3 {flock of file locked by child process} {
   flock -nowait $rdwrFH 0 5 start
} 0 0

set rdwrSize [fstat $rdwrFH size]

Test flock-4.4 {flock of file locked by child process} {
   flock -nowait $rdwrFH -$rdwrSize 5 end
} 0 0

Test flock-4.4 {flock of file locked by child process} {
   set stat [flock -nowait $rdwrFH 10 12 start]
   funlock $rdwrFH 10 12 start
   set stat
} 0 1

kill $lockerPid
wait $lockerPid

catch {close $readFH}
catch {close $writeFH}
catch {close $rdwrFH}
catch {close $fromChild}
catch {close $toParent}
unlink -nocomplain {FLOCKR.TMP FLOCKRW.TMP FLOCKW.TMP}